﻿{-# OPTIONS_GHC -XRecordWildCards -XTransformListComp #-}
module XI.Directory.Todo where
import XI.Directory.Types
import Data.Maybe
import Data.List
import Control.Monad.Error
import Data.Ord
import Control.Arrow
import GHC.Exts(the)

todo :: Configuration -> Either String [XIObj]
todo (scs, xos) = 
    if (nubBy cmp vals) == vals 
    then Right vals 
    else Left $ "Error! There are different objects with the same ID:\n" ++
            concatMap (\a->getId (head a) ++ " -> " ++ (show a) ++ "\n") 
                    (nub $ filter ((>1) . length) $ map (flip filter vals . cmp) vals)
    where
        cmp a = (==EQ) . comparing getId a
        vals0 = sort $ nub $ concatMap (todo_sc xos) scs ++ xos
        vals = (\(a,b) -> groupSc a ++ b) $ partition isSc vals0
        groupSc scs = [Sc { sc_name = the name,
                            sc_ids = sort $ nub $ concat ids } | 
                        (name, ids) <- map (\(Sc {..}) -> (sc_name, sc_ids)) scs, 
                        then group by name]

do_chains xos = sort . nub . concatMap (todo_ch xos)
    
todo_sc :: [XIObj] -> Scenario -> [XIObj]
todo_sc xos (Scenario {..}) = (map (flip Sc (sort $ nub $ map getId chained_objects)) $ maybeToList scenario_name) ++ 
                chained_objects
    where
        chained_objects = do_chains xos scenario_chains
  
todo_ch :: [XIObj] -> Chain -> [XIObj]
todo_ch xos (Chain {..}) = 
    [getById' CC {	
            cc_system = s_sys chain_sender,
            cc_name = s_cc chain_sender,
            cc_param = (CCSender, at)} | s_cc chain_sender /= "-"] ++ 
    [getById' SAgg {	
            sender = s_sys chain_sender,
            sender_int = s_int chain_sender,
            sender_cc = s_cc chain_sender } | s_cc chain_sender /= "-", isSAreq at] ++ 
    [getById' RD {	
            sender = s_sys chain_sender,
            sender_int = s_int chain_sender,
            cond_receivers = sort $ map (r_cond &&& r_sys) chain_receivers}] ++
    nub (map (\(Receiver {..})->getById' ID {	
                    sender = s_sys chain_sender,
                    sender_int = s_int chain_sender, 
                    receiver = r_sys,
                    cond_receiver_ints = sort $ map (\(RcvInt {..})->(ri_cond, r_int, mapping)) r_ints }
            ) chain_receivers) ++
    nub (concatMap (\(Receiver {..}) -> nub $ concatMap (\(RcvInt {..})-> if r_cc == "-" then [] else [
            getById' CC {	
                    cc_system = r_sys,
                    cc_name = r_cc,
                    cc_param = (CCReceiver, getAT ccs r_sys r_cc)},
            getById' RAgg {	
                    sender = s_sys chain_sender,
                    receiver = r_sys,
                    receiver_int = r_int,
                    receiver_cc = r_cc}]
        ) $ r_ints) chain_receivers)
    where 
        ccs = filter isCC xos
        at = getAT ccs (s_sys chain_sender) (s_cc chain_sender)
        getById' xo = getByIdDef xo xos

------- ------ -----------		
getById xo = take 1 . sortBy (comparing (negate . length . filter (=='*'). getId)) . filter (cmpId xo)
getByIdDef xo = fromMaybe xo . listToMaybe . filter ((xo==) . determineBy xo) . getById xo

chains :: [XIObj] -> [Chain]
chains xs = [Chain {	chain_sender = Sender {	s_sys = sender, 
                        s_cc = sender_cc, 
                        s_int = sender_int }, 
            chain_receivers = rs} | 
                SAgg {..} <- nub $ filter isAggS $
                    xs ++ 
                    [SAgg {	sender = cc_system,
                            sender_int = si,
                            sender_cc = cc_name	} | 
                        cc@(CC {..}) <- filter isCC xs, 
                        si <- maybeToList (getSIfromCC cc), 
                        not $ isSAreq $ snd cc_param] ++
                    [SAgg {	sender = system,
                            sender_int = sender_int,
                            sender_cc = "-"	} | 
                        RD {..} <- filter isRD xs, 
                        IP {..} <- filter isIP xs,
                        sender == system],
                RD {..} <- getById' (RD {	sender = sender,  
                                            sender_int = sender_int, 
                                            cond_receivers = []}),
                rs <- [[Receiver {  r_cond = cond,
                                    r_sys = r,
                                    r_ints = ris } |
                    (cond, r) <- cond_receivers,
                    ID {..} <- getById' ID {	sender = sender,  
                                                sender_int = sender_int, 
                                                receiver = r, 
                                                cond_receiver_ints = []},
                    ris <- [[RcvInt { ri_cond = condi,
                                      r_int = ri,
                                      mapping = m,
                                      r_cc = receiver_cc } | 
                        (condi, ri, m) <- cond_receiver_ints, 
                        RAgg {..} <- getById' RAgg { 
                                                sender = sender, 
                                                receiver = r,
                                                receiver_int = ri,
                                                receiver_cc = ""} ++
                                        [RAgg { 
                                                sender = system,
                                                receiver = r,
                                                receiver_int = ri,
                                                receiver_cc = "-"} | 
                                            IP {..} <- filter isIP xs,
                                            system == r]]],
                    length cond_receiver_ints == length ris
                ]],
                length cond_receivers == length rs
            ]
    where
        getById' xo = getById xo xs
  
scenarios' :: [XIObj] -> Either String [Scenario]
scenarios' xs = todo (sc_ch, filter isCC xs) >>= return . (sc_ch ++) . (:[]) . Scenario Nothing . chains . (xs\\)
    where
        sc_ch = filter (not . null . scenario_chains) $ 
            filter isSc xs >>= \(Sc {..})-> return $ Scenario {	scenario_name = Just sc_name,
                                                                scenario_chains = chains $ filter (\xo -> isIP xo || getId xo `elem` sc_ids) xs }
  
scenarios :: [XIObj] -> Either String Configuration
scenarios xs = do
    scs <- scenarios' xss
    xs' <- todo (scs, filter isCC xss)
    return $ (,) scs $ filter (null . filter (null . sc_ids) . filter isSc . (:[]))	$ map (fsc scs) $ (xss \\) $ filter (not.isCC) xs'
    where 
        xss = sort $ nub xs 
        fsc scs sc@(Sc {..}) = sc { sc_ids = filter (`elem` (map getId xss)) $ 
                                        sc_ids \\ (map getId $ concatMap (todo_ch xss) $ 
                                                                concatMap scenario_chains $ take 1 $ filter ((== Just sc_name) . scenario_name) scs)}
        fsc _ x = x
